home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH6 / SRC / BEZIER.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-03-30  |  7.6 KB  |  247 lines
  1. VERSION 4.00
  2. Begin VB.Form BezierForm 
  3.    Caption         =   "Bezier Curve"
  4.    ClientHeight    =   5490
  5.    ClientLeft      =   2175
  6.    ClientTop       =   930
  7.    ClientWidth     =   4830
  8.    Height          =   6180
  9.    Left            =   2115
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   366
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   322
  14.    Top             =   300
  15.    Width           =   4950
  16.    Begin VB.CommandButton CmdGo 
  17.       Caption         =   "Go"
  18.       Height          =   375
  19.       Left            =   4320
  20.       TabIndex        =   4
  21.       Top             =   0
  22.       Width           =   495
  23.    End
  24.    Begin VB.CheckBox ControlCheck 
  25.       Caption         =   "Show Control Points"
  26.       Height          =   255
  27.       Left            =   1080
  28.       TabIndex        =   3
  29.       Top             =   60
  30.       Value           =   1  'Checked
  31.       Width           =   1815
  32.    End
  33.    Begin VB.TextBox DtText 
  34.       Height          =   285
  35.       Left            =   240
  36.       TabIndex        =   2
  37.       Text            =   "0.01"
  38.       Top             =   45
  39.       Width           =   615
  40.    End
  41.    Begin VB.PictureBox Canvas 
  42.       AutoRedraw      =   -1  'True
  43.       Height          =   4815
  44.       Left            =   0
  45.       ScaleHeight     =   317
  46.       ScaleMode       =   3  'Pixel
  47.       ScaleWidth      =   317
  48.       TabIndex        =   0
  49.       Top             =   480
  50.       Width           =   4815
  51.    End
  52.    Begin VB.Label Label1 
  53.       Caption         =   "dt"
  54.       Height          =   255
  55.       Index           =   1
  56.       Left            =   0
  57.       TabIndex        =   1
  58.       Top             =   60
  59.       Width           =   255
  60.    End
  61.    Begin VB.Menu mnuFile 
  62.       Caption         =   "&File"
  63.       Begin VB.Menu mnuFileExit 
  64.          Caption         =   "E&xit"
  65.       End
  66.    End
  67. Attribute VB_Name = "BezierForm"
  68. Attribute VB_Creatable = False
  69. Attribute VB_Exposed = False
  70. Option Explicit
  71. Const PI = 3.14159
  72. Const GAP = 3
  73. ' The endpoints are points 1 and 4. The control
  74. ' points are points 2 and 3.
  75. Const NumPts = 4
  76. Dim PtX(1 To NumPts) As Single
  77. Dim PtY(1 To NumPts) As Single
  78. ' The index of the point being dragged.
  79. Dim Dragging As Integer
  80. Dim OldMode As Integer
  81. ' The Bezier curve parameters.
  82. Dim Ax As Single
  83. Dim Bx As Single
  84. Dim Cx As Single
  85. Dim Dx As Single
  86. Dim Ay As Single
  87. Dim By As Single
  88. Dim Cy As Single
  89. Dim Dy As Single
  90. ' ************************************************
  91. ' Draw the curve on the indicated picture box.
  92. ' ************************************************
  93. Sub DrawCurve(pic As PictureBox, start_t As Single, stop_t As Single, dt As Single)
  94. Dim x1 As Single
  95. Dim y1 As Single
  96. Dim t As Single
  97.     x1 = X(start_t)
  98.     y1 = Y(start_t)
  99.     pic.Cls
  100.     pic.CurrentX = x1
  101.     pic.CurrentY = y1
  102.     t = start_t + dt
  103.     Do While t < stop_t
  104.         x1 = X(t)
  105.         y1 = Y(t)
  106.         pic.Line -(x1, y1)
  107.         t = t + dt
  108.     Loop
  109.     x1 = X(stop_t)
  110.     y1 = Y(stop_t)
  111.     pic.Line -(x1, y1)
  112. End Sub
  113. ' ************************************************
  114. ' Compute the Bezier curve parameters.
  115. ' ************************************************
  116. Sub GetBezierValues(ex1 As Single, ey1 As Single, ex2 As Single, ey2 As Single, x1 As Single, y1 As Single, x2 As Single, y2 As Single, Ax As Single, Bx As Single, Cx As Single, Dx As Single, Ay As Single, By As Single, Cy As Single, Dy As Single)
  117.     Ax = ex2 - ex1 - 3 * x2 + 3 * x1
  118.     Bx = 3 * ex1 - 6 * x1 + 3 * x2
  119.     Cx = -3 * ex1 + 3 * x1
  120.     Dx = ex1
  121.     Ay = ey2 - ey1 - 3 * y2 + 3 * y1
  122.     By = 3 * ey1 - 6 * y1 + 3 * y2
  123.     Cy = -3 * ey1 + 3 * y1
  124.     Dy = ey1
  125. End Sub
  126. ' ************************************************
  127. ' The parametric function Y(t).
  128. ' ************************************************
  129. Function Y(t As Single) As Single
  130.     Y = Ay * t ^ 3 + By * t * t + Cy * t + Dy
  131. End Function
  132. ' ************************************************
  133. ' The parametric function X(t).
  134. ' ************************************************
  135. Function X(t As Single) As Single
  136.     X = Ax * t ^ 3 + Bx * t * t + Cx * t + Dx
  137. End Function
  138. ' ************************************************
  139. ' Prepare to draw the Bezier curve.
  140. ' ************************************************
  141. Private Sub DrawBezier()
  142. Const DOTTED = 2
  143. Dim dt As Single
  144. Dim i As Integer
  145.     ' Compute the curve parameters.
  146.     GetBezierValues _
  147.         PtX(1), PtY(1), _
  148.         PtX(4), PtY(4), _
  149.         PtX(2), PtY(2), _
  150.         PtX(3), PtY(3), _
  151.         Ax, Bx, Cx, Dx, Ay, By, Cy, Dy
  152.     ' Draw the curve.
  153.     dt = CSng(DtText.Text)
  154.     DrawCurve Canvas, 0, 1, dt
  155.     If ControlCheck.Value = vbChecked Then
  156.         ' Draw the control points.
  157.         For i = 1 To NumPts
  158.             Canvas.Line _
  159.                 (PtX(i) - GAP, PtY(i) - GAP)- _
  160.                 Step(2 * GAP, 2 * GAP), , BF
  161.         Next i
  162.         
  163.         ' Connect the control points.
  164.         OldMode = Canvas.DrawStyle
  165.         Canvas.DrawStyle = DOTTED
  166.         Canvas.CurrentX = PtX(1)
  167.         Canvas.CurrentY = PtY(1)
  168.         For i = 2 To NumPts
  169.             Canvas.Line -(PtX(i), PtY(i))
  170.         Next i
  171.         Canvas.DrawStyle = OldMode
  172.     End If
  173. End Sub
  174. ' ************************************************
  175. ' Select a point and start dragging it.
  176. ' ************************************************
  177. Private Sub Canvas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  178. Dim i As Integer
  179.     ' Find a close point.
  180.     For i = 1 To NumPts
  181.         If Abs(PtX(i) - X) <= GAP And _
  182.            Abs(PtY(i) - Y) <= GAP Then Exit For
  183.     Next i
  184.     If i > NumPts Then Exit Sub
  185.     Dragging = i
  186.     OldMode = Canvas.DrawMode
  187.     Canvas.DrawMode = vbInvert
  188.     PtX(Dragging) = X
  189.     PtY(Dragging) = Y
  190.     Canvas.Line _
  191.         (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _
  192.         Step(2 * GAP, 2 * GAP), , BF
  193. End Sub
  194. ' ************************************************
  195. ' Continue dragging a point.
  196. ' ************************************************
  197. Private Sub Canvas_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  198.     If Dragging < 1 Then Exit Sub
  199.     Canvas.Line _
  200.         (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _
  201.         Step(2 * GAP, 2 * GAP), , BF
  202.     PtX(Dragging) = X
  203.     PtY(Dragging) = Y
  204.     Canvas.Line _
  205.         (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _
  206.         Step(2 * GAP, 2 * GAP), , BF
  207. End Sub
  208. ' ************************************************
  209. ' Finish the drag and redraw the curve.
  210. ' ************************************************
  211. Private Sub Canvas_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  212.     If Dragging < 1 Then Exit Sub
  213.     Canvas.DrawMode = OldMode
  214.     PtX(Dragging) = X
  215.     PtY(Dragging) = Y
  216.     Dragging = 0
  217.     DrawBezier
  218. End Sub
  219. Private Sub CmdGo_Click()
  220.     DrawBezier
  221. End Sub
  222. Private Sub ControlCheck_Click()
  223.     DrawBezier
  224. End Sub
  225. Private Sub Form_Load()
  226.     PtX(1) = 0.4 * Canvas.ScaleWidth
  227.     PtX(2) = 0.1 * Canvas.ScaleWidth
  228.     PtX(3) = 0.8 * Canvas.ScaleWidth
  229.     PtX(4) = 0.6 * Canvas.ScaleWidth
  230.     PtY(1) = 0.8 * Canvas.ScaleHeight
  231.     PtY(2) = 0.3 * Canvas.ScaleHeight
  232.     PtY(3) = 0.2 * Canvas.ScaleHeight
  233.     PtY(4) = 0.7 * Canvas.ScaleHeight
  234. End Sub
  235. ' ************************************************
  236. ' Make the canvas as big as possible.
  237. ' ************************************************
  238. Private Sub Form_Resize()
  239.     Canvas.Move 0, Canvas.Top, _
  240.         ScaleWidth, ScaleHeight - Canvas.Top
  241.         
  242.     DrawBezier
  243. End Sub
  244. Private Sub mnuFileExit_Click()
  245.     Unload Me
  246. End Sub
  247.